unit clsCriptografyLib;

interface

uses Sysutils, classes, Types, Forms;

const
  { Component registration }
  DCPcipherpage     = 'DCPciphers';
  DCPhashpage       = 'DCPhashes';

  { ID values }
  DCP_rc2           =  1;
  DCP_sha1          =  2;
  DCP_rc5           =  3;
  DCP_rc6           =  4;
  DCP_blowfish      =  5;
  DCP_twofish       =  6;
  DCP_cast128       =  7;
  DCP_gost          =  8;
  DCP_rijndael      =  9;
  DCP_ripemd160     = 10;
  DCP_misty1        = 11;
  DCP_idea          = 12;
  DCP_mars          = 13;
  DCP_haval         = 14;
  DCP_cast256       = 15;
  DCP_md5           = 16;
  DCP_md4           = 17;

  DCP_rc4           = 19;
  DCP_ice           = 20;
  DCP_thinice       = 21;
  DCP_ice2          = 22;
  DCP_des           = 23;
  DCP_3des          = 24;

type
  TBuffer = Packed Array [1..255] of Char;

  TChave = Record
    Senha       : String[50];
    DataGeracao : String[50];
    Software    : String[50];
    Dias        : String[50];
    Usuarios    : String[50];
    Comentario  : String[100];
  end;

{******************************************************************************}
    { The base class from which all encryption components will be derived. }
    { Stream ciphers will be derived directly from this class where as     }
    { Block ciphers will have a further foundation class TDCP_blockcipher. }

type
  EDCP_cipher= class(Exception);
  TDCP_cipher= class(TComponent)
  protected
    fInitialized: boolean;  { Whether or not the key setup has been done yet }

    procedure DeadInt(Value: longint);   { Knudge to display vars in the object inspector   }
    procedure DeadStr(Value: string);    { Knudge to display vars in the object inspector   }

  public
    property Initialized: boolean
      read fInitialized;

    class function GetId: longint; virtual; abstract;
      { Get the algorithm id }
    class function GetAlgorithm: string; virtual; abstract;
      { Get the algorithm name }
    class function GetMaxKeySize: longint; virtual; abstract;
      { Get the maximum key size (in bits) }
    class function SelfTest: boolean; virtual; abstract;
      { Tests the implementation with several test vectors }

    procedure Init(const Key; Size: longint; InitVector: pointer); virtual;
      { Do key setup based on the data in Key, size is in bits }
    procedure InitStr(const Key: string);
      { Do key setup based on a hash of the key string }
    procedure Burn; virtual;
      { Clear all stored key information }
    procedure Reset; virtual; abstract;
      { Reset any stored chaining information }
    procedure Encrypt(const Indata; var Outdata; Size: longint); virtual; abstract;
      { Encrypt size bytes of data and place in Outdata }
    procedure Decrypt(const Indata; var Outdata; Size: longint); virtual; abstract;
      { Decrypt size bytes of data and place in Outdata }
    function EncryptStream(InStream, OutStream: TStream; Size: longint): longint;
      { Encrypt size bytes of data from InStream and place in OutStream }
    function DecryptStream(InStream, OutStream: TStream; Size: longint): longint;
      { Decrypt size bytes of data from InStream and place in OutStream }
    function EncryptString(const Str: string): string; virtual;
      { Encrypt a string and return Base64 encoded }
    function DecryptString(const Str: string): string; virtual;
      { Decrypt a Base64 encoded string }

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Id: longint
      read GetId write DeadInt;
    property Algorithm: string
      read GetAlgorithm write DeadStr;
    property MaxKeySize: longint
      read GetMaxKeySize write DeadInt;
  end;
  TDCP_cipherclass= class of TDCP_cipher;

  TDCP_ciphermode= (cmCBC, cmCFB8bit, cmCFBblock, cmOFB); // cmCFB8bit is equal to DCPcrypt v1.xx's CFB mode
  EDCP_blockcipher= class(EDCP_cipher);
  TDCP_blockcipher= class(TDCP_cipher)
  protected
    fCipherMode: TDCP_ciphermode;  { The cipher mode the encrypt method uses  }
    IV, Chain, Temp: Pbytearray;   { Storage for the chaining information     }
    BS: longint;                   { The block size in bytes for internal use }

  public
    class function GetBlockSize: longint; virtual; abstract;
      { Get the block size of the cipher (in bits) }

    procedure Reset; override;
      { Reset any stored chaining information }
    procedure Burn; override;
      { Clear all stored key information and chaining information }
    procedure SetIV(const Value);
      { Sets the IV to Value and performs a reset }
    procedure GetIV(var Value);
      { Returns the current chaining information, not the actual IV }

    procedure Encrypt(const Indata; var Outdata; Size: longint); override;
      { Encrypt size bytes of data and place in Outdata using CipherMode }
    procedure Decrypt(const Indata; var Outdata; Size: longint); override;
      { Decrypt size bytes of data and place in Outdata using CipherMode }
    function EncryptString(const Str: string): string; override;
      { Encrypt a string and return Base64 encoded }
    function DecryptString(const Str: string): string; override;
      { Decrypt a Base64 encoded string }
    procedure EncryptECB(const Indata; var Outdata); virtual; abstract;
      { Encrypt a block of data using the ECB method of encryption }
    procedure DecryptECB(const Indata; var Outdata); virtual; abstract;
      { Decrypt a block of data using the ECB method of decryption }
    procedure EncryptCBC(const Indata; var Outdata; Size: longint);
      { Encrypt size bytes of data using the CBC method of encryption }
    procedure DecryptCBC(const Indata; var Outdata; Size: longint);
      { Decrypt size bytes of data using the CBC method of decryption }
    procedure EncryptCFB8bit(const Indata; var Outdata; Size: longint);
      { Encrypt size bytes of data using the CFB (8 bit) method of encryption }
    procedure DecryptCFB8bit(const Indata; var Outdata; Size: longint);
      { Decrypt size bytes of data using the CFB (8 bit) method of decryption }
    procedure EncryptCFBblock(const Indata; var Outdata; Size: longint);
      { Encrypt size bytes of data using the CFB (block) method of encryption }
    procedure DecryptCFBblock(const Indata; var Outdata; Size: longint);
      { Decrypt size bytes of data using the CFB (block) method of decryption }
    procedure EncryptOFB(const Indata; var Outdata; Size: longint);
      { Encrypt size bytes of data using the OFB method of encryption }
    procedure DecryptOFB(const Indata; var Outdata; Size: longint);
      { Decrypt size bytes of data using the OFB method of decryption }

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property BlockSize: longint
      read GetBlockSize write DeadInt;
    property CipherMode: TDCP_ciphermode
      read fCipherMode write fCipherMode default cmCBC;
  end;
  TDCP_blockcipherclass= class of TDCP_blockcipher;


  TDCP_idea= class(TDCP_blockcipher)
  protected
    EK, DK: array[0..51] of word;
  public
    class function GetID: longint; override;
    class function GetAlgorithm: string; override;
    class function GetMaxKeySize: longint; override;
    class function GetBlockSize: longint; override;
    class function SelfTest: boolean; override;
    procedure Init(const Key; Size: longint; InitVector: pointer); override;
    procedure Burn; override;
    procedure EncryptECB(const InData; var OutData); override;
    procedure DecryptECB(const InData; var OutData); override;
  end;

  {******************************************************************************}
      { The base class from which all hash algorithms are to be derived  }

  type
    EDCP_hash= class(Exception);
    TDCP_hash= class(TComponent)
    protected
      fInitialized: boolean;  { Whether or not the algorithm has been initialized }

      procedure DeadInt(Value: longint);   { Knudge to display vars in the object inspector   }
      procedure DeadStr(Value: string);    { Knudge to display vars in the object inspector   }

    public
      property Initialized: boolean
        read fInitialized;

      class function GetId: longint; virtual; abstract;
        { Get the algorithm id }
      class function GetAlgorithm: string; virtual; abstract;
        { Get the algorithm name }
      class function GetHashSize: longint; virtual; abstract;
        { Get the size of the digest produced - in bits }
      class function SelfTest: boolean; virtual; abstract;
        { Tests the implementation with several test vectors }

      procedure Init; virtual; abstract;
        { Initialize the hash algorithm }
      procedure Final(var Digest); virtual; abstract;
        { Create the final digest and clear the stored information.
          The size of the Digest var must be at least equal to the hash size }
      procedure Burn; virtual; abstract;
        { Clear any stored information with out creating the final digest }

      procedure Update(const Buffer; Size: longint); virtual; abstract;
        { Update the hash buffer with Size bytes of data from Buffer }
      procedure UpdateStream(Stream: TStream; Size: longint);
        { Update the hash buffer with Size bytes of data from the stream }
      procedure UpdateStr(const Str: string);
        { Update the hash buffer with the string }

      destructor Destroy; override;

    published
      property Id: longint
        read GetId write DeadInt;
      property Algorithm: string
        read GetAlgorithm write DeadStr;
      property HashSize: longint
        read GetHashSize write DeadInt;
    end;
    TDCP_hashclass= class of TDCP_hash;



  {******************************************************************************}
  type
  { Since relatively few algorithms we can use an unordered linked list }
    PDCP_cipherinfo= ^TDCP_cipherinfo;
    TDCP_cipherinfo= record
      Next: PDCP_cipherinfo;
      Name: string;
      Id: longint;
      Cipher: TDCP_cipherclass;
      Block: boolean;
    end;
    PDCP_hashinfo= ^TDCP_hashinfo;
    TDCP_hashinfo= record
      Next: PDCP_hashinfo;
      Name: string;
      Id: longint;
      Hash: TDCP_hashclass;
    end;

  type
  TDCP_md5 = class(TDCP_hash)
  protected
    LenHi: longint;
    LenLo2, LenLo1: word; { annoying fix for D1-3 users who don't have longword }
    Index: DWord;
    CurrentHash: array[0..3] of DWord;
    HashBuffer: array[0..63] of byte;
    procedure Compress;
  public
    class function GetId: longint; override;
    class function GetAlgorithm: string; override;
    class function GetHashSize: longint; override;
    class function SelfTest: boolean; override;
    procedure Init; override;
    procedure Burn; override;
    procedure Update(const Buffer; Size: longint); override;
    procedure Final(var Digest); override;
  end;

type
  TDCP_sha1= class(TDCP_hash)
  protected
    LenHi: longint;
    LenLo2, LenLo1: word; { annoying fix for D1-3 users who don't have longword }
    Index: DWord;
    CurrentHash: array[0..4] of DWord;
    HashBuffer: array[0..63] of byte;
    procedure Compress;
  public
    class function GetId: longint; override;
    class function GetAlgorithm: string; override;
    class function GetHashSize: longint; override;
    class function SelfTest: boolean; override;
    procedure Init; override;
    procedure Final(var Digest); override;
    procedure Burn; override;
    procedure Update(const Buffer; Size: longint); override;
  end;

type
  Pbyte= ^byte;
  Pword= ^word;
  Pdword= ^dword;
{$IFDEF VER130} { Delphi 5 }
  dword= longword;
{$ELSE}
  {$IFDEF VER120} { Delphi 4 }
  dword= longword;
  {$ELSE}
    {$IFDEF VER125} { C++ Builder 4 }
  dword= longword;
    {$ELSE}
  dword= longint;
    {$ENDIF}
  {$ENDIF}
{$ENDIF}
{$IFDEF FPK}
  Pbytearray= ^Tbytearray;
  Tbytearray= array[0..32767] of byte;
{$ENDIF}
  Pwordarray= ^Twordarray;
  Twordarray= array[0..19383] of word;
  Pdwordarray= ^Tdwordarray;
  Tdwordarray= array[0..8191] of dword;

var
  MD5_Hash : TDCP_MD5;
  IDEA_Buffer : TDCP_Idea;
  DCPcipherlist: PDCP_cipherinfo;
  DCPhashlist: PDCP_hashinfo;

  Function GetHexa (Frase: String):String;
  Function GetDecimal (Frase : String) : String;
  Function MD5Hash(Buffer : String):String;
  Function Cifra(Buffer : String; KeyString : String) : String;
  Function Decifra(Buffer : String; KeyString : String):String;
  procedure DecifraArquivo(ArquivoIn, ArquivoOut : String;Senha:String);
  procedure CifraArquivo(ArquivoIn, ArquivoOut : String;Senha:String);

  function Base64EncodeStr(const Value: string): string;
    { Encode a string into Base64 format }
  function Base64DecodeStr(const Value: string): string;
    { Decode a Base64 format string }
  function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
    { Encode a lump of raw data (output is (4/3) times bigger than input) }
  function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
    { Decode a lump of raw data }

  function DCPcipherfromname(const Value: string; AOwner: TComponent): TDCP_cipher;
    { Create a cipher from the name supplied }
  function DCPcipherfromid(Value: longint; AOwner: TComponent): TDCP_cipher;
    { Create a cipher from the id number supplied }
  function DCPhashfromname(const Value: string; AOwner: TComponent): TDCP_hash;
    { Create a hash from the name supplied }
  function DCPhashfromid(Value: longint; AOwner: TComponent): TDCP_hash;
    { Create a hash from the id number supplied }

  {******************************************************************************}
  procedure DCPregcipher(Cipher: TDCP_cipherclass; Block: boolean);
    { Register a cipher with DCPcrypt }
  procedure DCPreghash(Hash: TDCP_hashclass);
    { Register a hash with DCPcrypt }

  procedure XorBlock(var InData1, InData2; Size: longint);
    { Xor two blocks of data together and place the result in Indata1 }
  function CompareMemory(X1, X2: PByteArray; Size: longint): boolean;
    { Compare the data at X1 with the data at X2 }
  function SwapDWord(X: dword): dword;
    { Swaps the byte order of a dword }
  function LRot16(X: Word; c: longint): Word;
    { Left rotate a 16bit word }
  function RRot16(X: Word; c: longint): Word;
    { Right rotate a 16bit word }
  function LRot32(X: DWord; c: longint): DWord;
    { Left rotate a 32bit word }
  function RRot32(X: DWord; c: longint): DWord;
    { Right rotate a 32bit word }
  function Cripto(Action, Src, Key: WideString): WideString;

implementation

const
  B64: array[0..63] of byte= (65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
    81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,
    109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,
    54,55,56,57,43,47);

//******************************************************************************
procedure TDCP_md5.Compress;
var
  Data: array[0..15] of dword;
  A, B, C, D: dword;
begin
  Move(HashBuffer,Data,Sizeof(Data));
  A:= CurrentHash[0];
  B:= CurrentHash[1];
  C:= CurrentHash[2];
  D:= CurrentHash[3];

  A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 0] + $d76aa478,7);
  D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 1] + $e8c7b756,12);
  C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 2] + $242070db,17);
  B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 3] + $c1bdceee,22);
  A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 4] + $f57c0faf,7);
  D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 5] + $4787c62a,12);
  C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 6] + $a8304613,17);
  B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 7] + $fd469501,22);
  A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 8] + $698098d8,7);
  D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 9] + $8b44f7af,12);
  C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[10] + $ffff5bb1,17);
  B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[11] + $895cd7be,22);
  A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[12] + $6b901122,7);
  D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[13] + $fd987193,12);
  C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[14] + $a679438e,17);
  B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[15] + $49b40821,22);

  A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 1] + $f61e2562,5);
  D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 6] + $c040b340,9);
  C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[11] + $265e5a51,14);
  B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 0] + $e9b6c7aa,20);
  A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 5] + $d62f105d,5);
  D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[10] + $02441453,9);
  C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[15] + $d8a1e681,14);
  B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 4] + $e7d3fbc8,20);
  A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 9] + $21e1cde6,5);
  D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[14] + $c33707d6,9);
  C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 3] + $f4d50d87,14);
  B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 8] + $455a14ed,20);
  A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[13] + $a9e3e905,5);
  D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 2] + $fcefa3f8,9);
  C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 7] + $676f02d9,14);
  B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[12] + $8d2a4c8a,20);

  A:= B + LRot32(A + (B xor C xor D) + Data[ 5] + $fffa3942,4);
  D:= A + LRot32(D + (A xor B xor C) + Data[ 8] + $8771f681,11);
  C:= D + LRot32(C + (D xor A xor B) + Data[11] + $6d9d6122,16);
  B:= C + LRot32(B + (C xor D xor A) + Data[14] + $fde5380c,23);
  A:= B + LRot32(A + (B xor C xor D) + Data[ 1] + $a4beea44,4);
  D:= A + LRot32(D + (A xor B xor C) + Data[ 4] + $4bdecfa9,11);
  C:= D + LRot32(C + (D xor A xor B) + Data[ 7] + $f6bb4b60,16);
  B:= C + LRot32(B + (C xor D xor A) + Data[10] + $bebfbc70,23);
  A:= B + LRot32(A + (B xor C xor D) + Data[13] + $289b7ec6,4);
  D:= A + LRot32(D + (A xor B xor C) + Data[ 0] + $eaa127fa,11);
  C:= D + LRot32(C + (D xor A xor B) + Data[ 3] + $d4ef3085,16);
  B:= C + LRot32(B + (C xor D xor A) + Data[ 6] + $04881d05,23);
  A:= B + LRot32(A + (B xor C xor D) + Data[ 9] + $d9d4d039,4);
  D:= A + LRot32(D + (A xor B xor C) + Data[12] + $e6db99e5,11);
  C:= D + LRot32(C + (D xor A xor B) + Data[15] + $1fa27cf8,16);
  B:= C + LRot32(B + (C xor D xor A) + Data[ 2] + $c4ac5665,23);

  A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 0] + $f4292244,6);
  D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 7] + $432aff97,10);
  C:= D + LRot32(C + (A xor (D or (not B))) + Data[14] + $ab9423a7,15);
  B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 5] + $fc93a039,21);
  A:= B + LRot32(A + (C xor (B or (not D))) + Data[12] + $655b59c3,6);
  D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 3] + $8f0ccc92,10);
  C:= D + LRot32(C + (A xor (D or (not B))) + Data[10] + $ffeff47d,15);
  B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 1] + $85845dd1,21);
  A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 8] + $6fa87e4f,6);
  D:= A + LRot32(D + (B xor (A or (not C))) + Data[15] + $fe2ce6e0,10);
  C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 6] + $a3014314,15);
  B:= C + LRot32(B + (D xor (C or (not A))) + Data[13] + $4e0811a1,21);
  A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 4] + $f7537e82,6);
  D:= A + LRot32(D + (B xor (A or (not C))) + Data[11] + $bd3af235,10);
  C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 2] + $2ad7d2bb,15);
  B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 9] + $eb86d391,21);

  Inc(CurrentHash[0],A);
  Inc(CurrentHash[1],B);
  Inc(CurrentHash[2],C);
  Inc(CurrentHash[3],D);
  Index:= 0;
  FillChar(HashBuffer,Sizeof(HashBuffer),0);
end;
//******************************************************************************
class function TDCP_md5.GetHashSize: longint;
begin
  Result:= 128;
end;
//******************************************************************************
class function TDCP_md5.GetId: longint;
begin
  Result:= DCP_md5;
end;
//******************************************************************************
class function TDCP_md5.GetAlgorithm: string;
begin
  Result:= 'MD5';
end;
//******************************************************************************
class function TDCP_md5.SelfTest: boolean;
const
  Test1Out: array[0..15] of byte=
    ($90,$01,$50,$98,$3c,$d2,$4f,$b0,$d6,$96,$3f,$7d,$28,$e1,$7f,$72);
  Test2Out: array[0..15] of byte=
    ($c3,$fc,$d3,$d7,$61,$92,$e4,$00,$7d,$fb,$49,$6c,$ca,$67,$e1,$3b);
var
  TestHash: TDCP_md5;
  TestOut: array[0..19] of byte;
begin
  TestHash:= TDCP_md5.Create(nil);
  TestHash.Init;
  TestHash.UpdateStr('abc');
  TestHash.Final(TestOut);
  Result:= CompareMemory(@TestOut,@Test1Out,Sizeof(Test1Out));
  TestHash.Init;
  TestHash.UpdateStr('abcdefghijklmnopqrstuvwxyz');
  TestHash.Final(TestOut);
  Result:= CompareMemory(@TestOut,@Test2Out,Sizeof(Test2Out)) and Result;
  TestHash.Free;
end;
//******************************************************************************
procedure TDCP_md5.Init;
begin
  Burn;
  CurrentHash[0]:= $67452301;
  CurrentHash[1]:= $efcdab89;
  CurrentHash[2]:= $98badcfe;
  CurrentHash[3]:= $10325476;
  fInitialized:= true;
end;
//******************************************************************************
procedure TDCP_md5.Burn;
begin
  LenHi:= 0; LenLo1:= 0; LenLo2:= 0;
  Index:= 0;
  FillChar(HashBuffer,Sizeof(HashBuffer),0);
  FillChar(CurrentHash,Sizeof(CurrentHash),0);
  fInitialized:= false;
end;
//******************************************************************************
procedure TDCP_md5.Update(const Buffer; Size: longint);
var
  PBuf: ^byte;
begin
  if not fInitialized then
    raise EDCP_hash.Create('Hash not initialized');

  { I wish Borland had included an unsigned 32bit from the start }
  Inc(LenLo1,(Size shl 3) and $FFFF);
  if LenLo1< ((Size shl 3) and $FFFF) then
  begin
    Inc(LenLo2);
    if LenLo2= 0 then
      Inc(LenHi);
  end;
  Inc(LenLo2,Size shr 13);
  if LenLo2< ((Size shr 13) and $FFFF) then
    Inc(LenHi);
  Inc(LenHi,Size shr 29);

  PBuf:= @Buffer;
  while Size> 0 do
  begin
    if (Sizeof(HashBuffer)-Index)<= DWord(Size) then
    begin
      Move(PBuf^,HashBuffer[Index],Sizeof(HashBuffer)-Index);
      Dec(Size,Sizeof(HashBuffer)-Index);
      Inc(PBuf,Sizeof(HashBuffer)-Index);
      Compress;
    end
    else
    begin
      Move(PBuf^,HashBuffer[Index],Size);
      Inc(Index,Size);
      Size:= 0;
    end;
  end;
end;
//******************************************************************************
procedure TDCP_md5.Final(var Digest);
begin
  if not fInitialized then
    raise EDCP_hash.Create('Hash not initialized');
  HashBuffer[Index]:= $80;
  if Index>= 56 then
    Compress;
  PDWord(@HashBuffer[56])^:= LenLo1 or (longint(LenLo2) shl 16);
  PDWord(@HashBuffer[60])^:= LenHi;
  Compress;
  Move(CurrentHash,Digest,Sizeof(CurrentHash));
  Burn;
end;
//******************************************************************************
function Cripto(Action, Src, Key: WideString): WideString;
var
   KeyLen    : Integer;
   KeyPos    : Integer;
   offset    : Integer;
   dest      : string;
   SrcPos    : Integer;
   SrcAsc    : Integer;
   TmpSrcAsc : Integer;
   Range     : Integer;
    s : string[255];
    c : array[0..255] of Byte absolute s;
    i: Integer;
begin
     dest:='';
     KeyLen:=Length(Key);
     KeyPos:=0;
     SrcPos:=0;
     SrcAsc:=0;
     Range:=256;
     if Action = UpperCase('E') then
     begin
          Randomize;
          offset:=Random(Range);
          dest:=format('%1.2x',[offset]);
          for SrcPos := 1 to Length(Src) do
          begin
               SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
               if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
               SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
               dest:=dest + format('%1.2x',[SrcAsc]);
               offset:=SrcAsc;
          end;
     end;
     if Action = UpperCase('D') then
     begin
          offset:=StrToInt('$'+ copy(src,1,2));
          SrcPos:=3;
          repeat
                SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
                if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;
                TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
                if TmpSrcAsc <= offset then
                     TmpSrcAsc := 255 + TmpSrcAsc - offset
                else
                     TmpSrcAsc := TmpSrcAsc - offset;
                dest := dest + chr(TmpSrcAsc);
                offset:=srcAsc;
                SrcPos:=SrcPos + 2;
          until SrcPos >= Length(Src);
     end;
     Cripto:=dest;
end;
//******************************************************************************
Function Cifra(Buffer : String; KeyString : String) : String;
Var Temp : String;
begin
  IDEA_Buffer := TDCP_Idea.Create(Application);
  Temp:=MD5Hash(KeyString);
  IDEA_Buffer.InitStr(Temp);
  Temp:=IDEA_Buffer.EncryptString(Buffer);
  Result:=GetHexa(Temp);
  IDEA_Buffer.Burn;
  IDEA_Buffer.Free;
end;
//******************************************************************************
Function Decifra(Buffer : String; KeyString : String):String;
Var Temp : String;
begin
  Temp:=GetDecimal(Buffer);
  IDEA_Buffer := TDCP_Idea.Create(Application);
  IDEA_Buffer.InitStr(MD5Hash(KeyString));
  Result:=IDEA_Buffer.DecryptString(Temp);
  IDEA_Buffer.Burn;
  IDEA_Buffer.Free;
end;
//******************************************************************************
Function GetDecimal (Frase : String) : String;
Var j     : integer;
    c     : Byte;
    s,b   : String;
begin
  b:='';
  for j:= 1 to Length(Frase) do
  begin
    s:= copy(Frase,1,2);
    try
      Delete(Frase,1,2);
    except end;
    If length(s)<>2 then continue;
    s:='$'+s;
    c:=StrToInt(s);
    b:=b+Chr(c);
  end;
  Result:=b;
end;
//******************************************************************************
Function GetHexa (Frase: String):String;
Var j : integer;
    s : String;
    c : Byte;
begin
  s:='';
  For j:=1 to length(Frase) do
  begin
    c:=Ord(Frase[j]);
    s:=s+IntToHex(c,2);
  end;
  Result:=s;
end;
//******************************************************************************
Function MD5Hash(Buffer : String):String;
Var Hash : Array[0..15] of byte;  //31
    Temp : String;
    f    : Byte;
begin
  For f:=0 to 15 do Hash[f]:=0;
  Buffer:=Trim(Buffer);
  MD5_Hash:=TDCP_MD5.Create(NIL);
  MD5_Hash.Init;
  MD5_Hash.UpdateStr(Buffer);
  MD5_Hash.Final(Hash);
  For f:=0 to 15 do Temp:=Temp+IntToHex(Hash[f],2);
  Result:=Copy(Temp,1,32);
  MD5_Hash.Burn;
  MD5_Hash.Free;
end;
//******************************************************************************
procedure CifraArquivo(ArquivoIn, ArquivoOut : String;Senha:String);
var
  Cipher: TDCP_IDEA;
  Input, Output: TFileStream;
  Progress, Done: longint;
  Header: packed record     { This is the header of the encrypted file }
    Id: longint;
    Check1, Check2: longint;
  end;
begin
  if not FileExists(ArquivoIn) then Exit;
  Cipher:= TDCP_IDEA.Create(Application);
  try
    Input:= TFileStream.Create(ArquivoIn,fmOpenRead); { Open the input file }
  except
    Cipher.Free;
    Exit;
  end;
  try
    Output:= TFileStream.Create(ArquivoOut,fmCreate); { Open the output file }
  except
    Cipher.Free;
    Input.Free;
    Exit;
  end;
  Progress:= 0;     { Progress contains the total bytes done }
  Header.Id:= Cipher.Id;  { Store the cipher id so we know what algorithm to use
                            on decrypting }
  Header.Check1:= Random($FFFF) or (Random($FFFF) shl 16);
  Header.Check2:= Header.Check1;
    { To check that we have the right passphrase on decryption if we store a
      random number twice then when we decrypt we know that the two numbers
      should match }
  Cipher.InitStr(Senha); { Initialize the cipher using the passphrase }
  if Cipher is TDCP_blockcipher then
    TDCP_blockcipher(Cipher).CipherMode:= cmCFBblock; { Set the appropriate mode if a block cipher }
  Cipher.Encrypt(Header.Check1,Header.Check1,8); { Encrypt the last 8 bytes of header - NOT the id }
  Output.Write(Header,Sizeof(Header));
  repeat
    Done:= Cipher.EncryptStream(Input,Output,32768);  { Encrypt the file 32768 bytes at a time }
    Inc(Progress,Done);
  until Done<> 32768;
  Input.Free;   { Free all resources used }
  Output.Free;
  Cipher.Burn;  { Remember to Burn after use }
  Cipher.Free;
  FillChar(Header,Sizeof(Header),0);
end;
//******************************************************************************
procedure DecifraArquivo(ArquivoIn, ArquivoOut : String;Senha:String);
var
  Cipher: TDCP_IDEA;
  Input, Output: TFileStream;
  Progress, Done: longint;
  Header : packed record
     Id  : longint;
     Check1, Check2: longint;
  end;
begin
  if not FileExists(ArquivoIn) then Exit;
  try
    Input:= TFileStream.Create(ArquivoIn,fmOpenRead);
  except
    Exit;
  end;
  try
    Output:= TFileStream.Create(ArquivoOut,fmCreate);
  except
    Input.Free;
    Exit;
  end;
  Input.Read(Header,Sizeof(Header));
  Cipher:= TDCP_IDEA.Create(Application);
  Progress:= 0;
  Cipher.InitStr(Senha); { Initialize the cipher with the passphrase }
  if Cipher is TDCP_blockcipher then
    TDCP_blockcipher(Cipher).CipherMode:= cmCFBblock; { Set the mode }
  Cipher.Decrypt(Header.Check1,Header.Check1,8); { Decrypt the header and check that the
                                                   two numbers we stored are the same }
  if Header.Check1<> Header.Check2 then
  begin
    Input.Free;
    Output.Free;
    DeleteFile(ArquivoOut);
    Cipher.Burn;
    Cipher.Free;
    Exit;
  end;
  repeat
    Done:= Cipher.DecryptStream(Input,Output,32768);  { Decrypt the file }
    Inc(Progress,Done);
//    DecProgressBar.Position:= (Progress*100) div Input.Size;
  until Done<> 32768;
  Input.Free;
  Output.Free;
  Cipher.Burn;  { Remember to Burn }
  Cipher.Free;
  FillChar(Header,Sizeof(Header),0);
end;
//******************************************************************************
function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
var
  i, iptr, optr: integer;
  Input, Output: PByteArray;
begin
  Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
  iptr:= 0; optr:= 0;
  for i:= 1 to (Size div 3) do
  begin
    Output^[optr+0]:= B64[Input^[iptr] shr 2];
    Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
    Output^[optr+2]:= B64[((Input^[iptr+1] and 15) shl 2) + (Input^[iptr+2] shr 6)];
    Output^[optr+3]:= B64[Input^[iptr+2] and 63];
    Inc(optr,4); Inc(iptr,3);
  end;
  case (Size mod 3) of
    1: begin
         Output^[optr+0]:= B64[Input^[iptr] shr 2];
         Output^[optr+1]:= B64[(Input^[iptr] and 3) shl 4];
         Output^[optr+2]:= byte('=');
         Output^[optr+3]:= byte('=');
       end;
    2: begin
         Output^[optr+0]:= B64[Input^[iptr] shr 2];
         Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
         Output^[optr+2]:= B64[(Input^[iptr+1] and 15) shl 2];
         Output^[optr+3]:= byte('=');
       end;
  end;
  Result:= ((Size+2) div 3) * 4;
end;
//******************************************************************************
function Base64EncodeStr(const Value: string): string;
begin
  SetLength(Result,((Length(Value)+2) div 3) * 4);
  Base64Encode(@Value[1],@Result[1],Length(Value));
end;
//******************************************************************************
function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
var
  i, j, iptr, optr: integer;
  Temp: array[0..3] of byte;
  Input, Output: PByteArray;
begin
  Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
  iptr:= 0; optr:= 0;
  Result:= 0;
  for i:= 1 to (Size div 4) do
  begin
    for j:= 0 to 3 do
    begin
      case Input^[iptr] of
        65..90 : Temp[j]:= Input^[iptr] - Ord('A');
        97..122: Temp[j]:= Input^[iptr] - Ord('a') + 26;
        48..57 : Temp[j]:= Input^[iptr] - Ord('0') + 52;
        43     : Temp[j]:= 62;
        47     : Temp[j]:= 63;
        61     : Temp[j]:= $FF;
      end;
      Inc(iptr);
    end;
    Output^[optr]:= (Temp[0] shl 2) or (Temp[1] shr 4);
    Result:= optr+1;
    if (Temp[2]<> $FF) and (Temp[3]= $FF) then
    begin
      Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
      Result:= optr+2;
      Inc(optr)
    end
    else if (Temp[2]<> $FF) then
    begin
      Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
      Output^[optr+2]:= (Temp[2] shl 6) or  Temp[3];
      Result:= optr+3;
      Inc(optr,2);
    end;
    Inc(optr);
  end;
end;
//******************************************************************************
function Base64DecodeStr(const Value: string): string;
begin
  SetLength(Result,(Length(Value) div 4) * 3);
  SetLength(Result,Base64Decode(@Value[1],@Result[1],Length(Value)));
end;
//******************************************************************************
class function TDCP_idea.GetMaxKeySize: longint;
begin
  Result:= 128;
end;
//******************************************************************************
class function TDCP_idea.GetBlockSize: longint;
begin
  Result:= 64;
end;
//******************************************************************************
class function TDCP_idea.GetID: longint;
begin
  Result:= DCP_idea;
end;
//******************************************************************************
class function TDCP_idea.GetAlgorithm: string;
begin
  Result:= 'IDEA';
end;
//******************************************************************************
class function TDCP_idea.SelfTest: boolean;
const
  Key1: array[0..15] of byte=
    ($3A,$98,$4E,$20,$00,$19,$5D,$B3,$2E,$E5,$01,$C8,$C4,$7C,$EA,$60);
  InData1: array[0..7] of byte=
    ($01,$02,$03,$04,$05,$06,$07,$08);
  OutData1: array[0..7] of byte=
    ($97,$BC,$D8,$20,$07,$80,$DA,$86);
  Key2: array[0..15] of byte=
    ($00,$64,$00,$C8,$01,$2C,$01,$90,$01,$F4,$02,$58,$02,$BC,$03,$20);
  InData2: array[0..7] of byte=
    ($05,$32,$0A,$64,$14,$C8,$19,$FA);
  OutData2: array[0..7] of byte=
    ($65,$BE,$87,$E7,$A2,$53,$8A,$ED);
var
  Cipher: TDCP_idea;
  Data: array[0..7] of byte;
begin
  Cipher:= TDCP_idea.Create(nil);
  Cipher.Init(Key1,Sizeof(Key1)*8,nil);
  Cipher.EncryptECB(InData1,Data);
  Result:= boolean(CompareMemory(@Data,@OutData1,Sizeof(Data)));
  Cipher.DecryptECB(Data,Data);
  Result:= Result and boolean(CompareMemory(@Data,@InData1,Sizeof(Data)));
  Cipher.Burn;
  Cipher.Init(Key2,Sizeof(Key2)*8,nil);
  Cipher.EncryptECB(InData2,Data);
  Result:= Result and boolean(CompareMemory(@Data,@OutData2,Sizeof(Data)));
  Cipher.DecryptECB(Data,Data);
  Result:= Result and boolean(CompareMemory(@Data,@InData2,Sizeof(Data)));
  Cipher.Burn;
  Cipher.Free;
end;
//******************************************************************************
function MulInv(x: word): word;
var
  t0, t1, q, y: word;
begin
  if x<= 1 then
  begin
    Result:= x;
    Exit;
  end;
  t1:= DWord($10001) div x;
  y:= DWord($10001) mod x;
  if y= 1 then
  begin
    Result:= (1 - t1) and $FFFF;
    Exit;
  end;
  t0:= 1;
  repeat
    q:= x div y;
    x:= x mod y;
    t0:= t0 + (q*t1);
    if x= 1 then
    begin
      Result:= t0;
      Exit;
    end;
    q:= y div x;
    y:= y mod x;
    t1:= t1 + (q*t0);
  until y= 1;
  Result:= (1-t1) and $FFFF;
end;
//******************************************************************************
procedure TDCP_idea.Init(const Key; Size: longint; InitVector: pointer);
var
  i: integer;
begin
  inherited Init(Key,Size,InitVector);
  Size:= Size div 8;

  FillChar(EK,Sizeof(EK),0);
  Move(Key,EK,Size);
  for i:= 0 to 7 do
    EK[i]:= (EK[i] shl 8) or (EK[i] shr 8);
  for i:= 1 to 5 do
  begin
    EK[(i*8)+0]:= (EK[((i-1)*8)+1] shl 9) or (EK[((i-1)*8)+2] shr 7);
    EK[(i*8)+1]:= (EK[((i-1)*8)+2] shl 9) or (EK[((i-1)*8)+3] shr 7);
    EK[(i*8)+2]:= (EK[((i-1)*8)+3] shl 9) or (EK[((i-1)*8)+4] shr 7);
    EK[(i*8)+3]:= (EK[((i-1)*8)+4] shl 9) or (EK[((i-1)*8)+5] shr 7);
    EK[(i*8)+4]:= (EK[((i-1)*8)+5] shl 9) or (EK[((i-1)*8)+6] shr 7);
    EK[(i*8)+5]:= (EK[((i-1)*8)+6] shl 9) or (EK[((i-1)*8)+7] shr 7);
    EK[(i*8)+6]:= (EK[((i-1)*8)+7] shl 9) or (EK[((i-1)*8)+0] shr 7);
    EK[(i*8)+7]:= (EK[((i-1)*8)+0] shl 9) or (EK[((i-1)*8)+1] shr 7);
  end;
  EK[48]:= (EK[41] shl 9) or (EK[42] shr 7);
  EK[49]:= (EK[42] shl 9) or (EK[43] shr 7);
  EK[50]:= (EK[43] shl 9) or (EK[44] shr 7);
  EK[51]:= (EK[44] shl 9) or (EK[45] shr 7);

  DK[51]:= MulInv(EK[3]);
  DK[50]:= -EK[2];
  DK[49]:= -EK[1];
  DK[48]:= MulInv(EK[0]);
  for i:= 0 to 6 do
  begin
    DK[47-i*6]:= EK[i*6+5];
    DK[46-i*6]:= EK[i*6+4];
    DK[45-i*6]:= MulInv(EK[i*6+9]);
    DK[44-i*6]:= -EK[i*6+7];
    DK[43-i*6]:= -EK[i*6+8];
    DK[42-i*6]:= MulInv(EK[i*6+6]);
  end;
  DK[5]:= EK[47];
  DK[4]:= EK[46];
  DK[3]:= MulInv(EK[51]);
  DK[2]:= -EK[50];
  DK[1]:= -EK[49];
  DK[0]:= MulInv(EK[48]);

  { Generate a "random" IV }
  if InitVector= nil then
  begin
    FillChar(IV^,BS,0);
    EncryptECB(IV^,IV^);
    Reset;
  end
  else
  begin
    Move(InitVector^,IV^,BS);
    Reset;
  end;
end;
//******************************************************************************
procedure TDCP_idea.Burn;
begin
  FillChar(EK,Sizeof(EK),0);
  FillChar(DK,Sizeof(DK),0);
  inherited Burn;
end;
//******************************************************************************
procedure Mul(var x: word; const y: word);
var
  p: DWord;
  t16: word;
begin
  p:= DWord(x)*y;
  if p= 0 then
    x:= 1 - x - y
  else
  begin
    x:= p shr 16;
    t16:= p and $FFFF;
    x:= t16 - x;
    if (t16 < x) then
      Inc(x);
  end;
end;
//******************************************************************************
procedure TDCP_idea.EncryptECB(const InData; var OutData);
var
  x: array[1..4] of word;
  s3, s2: word;
  i: longint;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  PDword(@X[1])^:= PDword(@InData)^;
  PDword(@X[3])^:= PDword(dword(@InData)+4)^;
  for i:= 1 to 4 do
    x[i]:= (x[i] shl 8) or (x[i] shr 8);
  for i:= 0 to 7 do
  begin
    Mul(x[1],EK[(i*6)+0]);
    Inc(x[2],EK[(i*6)+1]);
    Inc(x[3],EK[(i*6)+2]);
    Mul(x[4],EK[(i*6)+3]);
    s3:= x[3];
    x[3]:= x[3] xor x[1];
    Mul(x[3],EK[(i*6)+4]);
    s2:= x[2];
    x[2]:= x[2] xor x[4];
    Inc(x[2],x[3]);
    Mul(x[2],EK[(i*6)+5]);
    Inc(x[3],x[2]);
    x[1]:= x[1] xor x[2];
    x[4]:= x[4] xor x[3];
    x[2]:= x[2] xor s3;
    x[3]:= x[3] xor s2;
  end;
  Mul(x[1],EK[48]);
  Inc(x[3],EK[49]);
  Inc(x[2],EK[50]);
  Mul(x[4],EK[51]);
  x[1]:= (x[1] shl 8) or (x[1] shr 8);
  s2:= (x[3] shl 8) or (x[3] shr 8);
  x[3]:= (x[2] shl 8) or (x[2] shr 8);
  x[4]:= (x[4] shl 8) or (x[4] shr 8);
  x[2]:= s2;
  PDword(@OutData)^:= PDword(@x[1])^;
  PDword(dword(@OutData)+4)^:= PDword(@x[3])^;
end;
//******************************************************************************
procedure TDCP_idea.DecryptECB(const InData; var OutData);
var
  x: array[1..4] of word;
  s3, s2: word;
  i: longint;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  PDword(@X[1])^:= PDword(@InData)^;
  PDword(@X[3])^:= PDword(dword(@InData)+4)^;
  for i:= 1 to 4 do
    x[i]:= (x[i] shl 8) or (x[i] shr 8);
  for i:= 0 to 7 do
  begin
    Mul(x[1],DK[(i*6)+0]);
    Inc(x[2],DK[(i*6)+1]);
    Inc(x[3],DK[(i*6)+2]);
    Mul(x[4],DK[(i*6)+3]);
    s3:= x[3];
    x[3]:= x[3] xor x[1];
    Mul(x[3],DK[(i*6)+4]);
    s2:= x[2];
    x[2]:= x[2] xor x[4];
    Inc(x[2],x[3]);
    Mul(x[2],DK[(i*6)+5]);
    Inc(x[3],x[2]);
    x[1]:= x[1] xor x[2];
    x[4]:= x[4] xor x[3];
    x[2]:= x[2] xor s3;
    x[3]:= x[3] xor s2;
  end;
  Mul(x[1],DK[48]);
  Inc(x[3],DK[49]);
  Inc(x[2],DK[50]);
  Mul(x[4],DK[51]);
  x[1]:= (x[1] shl 8) or (x[1] shr 8);
  s2:= (x[3] shl 8) or (x[3] shr 8);
  x[3]:= (x[2] shl 8) or (x[2] shr 8);
  x[4]:= (x[4] shl 8) or (x[4] shr 8);
  x[2]:= s2;
  PDword(@OutData)^:= PDword(@x[1])^;
  PDword(dword(@OutData)+4)^:= PDword(@x[3])^;
end;
//******************************************************************************
procedure TDCP_cipher.DeadInt(Value: longint);
begin
end;

procedure TDCP_cipher.DeadStr(Value: string);
begin
end;

procedure TDCP_cipher.Init(const Key; Size: longint; InitVector: pointer);
begin
  if fInitialized then
    Burn;
  if (Size <= 0) or ((Size and 3)<> 0) or (Size> GetMaxKeySize) then
    raise Exception.Create('Invalid key size')
  else
    fInitialized:= true;
end;

procedure TDCP_cipher.InitStr(const Key: string);
var
  Hash: TDCP_sha1;
  Digest: array[0..19] of byte;  { SHA1 produces a 20byte digest }
begin
  if fInitialized then
    Burn;
  Hash:= TDCP_sha1.Create(Self);
  Hash.Init;
  Hash.UpdateStr(Key);
  Hash.Final(Digest);
  Hash.Free;
  if MaxKeySize< 160 then
    Init(Digest,MaxKeySize,nil)
  else
    Init(Digest,160,nil);
  FillChar(Digest,Sizeof(Digest),$FF);
end;

procedure TDCP_cipher.Burn;
begin
  fInitialized:= false;
end;

function TDCP_cipher.EncryptStream(InStream, OutStream: TStream; Size: longint): longint;
var
  Buffer: array[0..8191] of byte;
  i, Read: longint;
begin
  Result:= 0;
  for i:= 1 to (Size div Sizeof(Buffer)) do
  begin
    Read:= InStream.Read(Buffer,Sizeof(Buffer));
    Inc(Result,Read);
    Encrypt(Buffer,Buffer,Read);
    OutStream.Write(Buffer,Read);
  end;
  if (Size mod Sizeof(Buffer))<> 0 then
  begin
    Read:= InStream.Read(Buffer,Size mod Sizeof(Buffer));
    Inc(Result,Read);
    Encrypt(Buffer,Buffer,Read);
    OutStream.Write(Buffer,Read);
  end;
end;

function TDCP_cipher.DecryptStream(InStream, OutStream: TStream; Size: longint): longint;
var
  Buffer: array[0..8191] of byte;
  i, Read: longint;
begin
  Result:= 0;
  for i:= 1 to (Size div Sizeof(Buffer)) do
  begin
    Read:= InStream.Read(Buffer,Sizeof(Buffer));
    Inc(Result,Read);
    Decrypt(Buffer,Buffer,Read);
    OutStream.Write(Buffer,Read);
  end;
  if (Size mod Sizeof(Buffer))<> 0 then
  begin
    Read:= InStream.Read(Buffer,Size mod Sizeof(Buffer));
    Inc(Result,Read);
    Decrypt(Buffer,Buffer,Read);
    OutStream.Write(Buffer,Read);
  end;
end;

function TDCP_cipher.EncryptString(const Str: string): string;
begin
  SetLength(Result,Length(Str));
  Encrypt(Str[1],Result[1],Length(Str));
  Result:= Base64EncodeStr(Result);
end;

function TDCP_cipher.DecryptString(const Str: string): string;
begin
  Result:= Base64DecodeStr(Str);
  Decrypt(Result[1],Result[1],Length(Result));
end;

constructor TDCP_cipher.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Burn;
end;

destructor TDCP_cipher.Destroy;
begin
  if fInitialized then
    Burn;
  inherited Destroy;
end;



{** TDCP_blockcipher **********************************************************}

procedure TDCP_blockcipher.Reset;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized')
  else
    Move(IV^,Chain^,BS);
end;

procedure TDCP_blockcipher.Burn;
begin
  if IV<> nil then
  begin
    FillChar(IV^,BS,$FF);
    FillChar(Chain^,BS,$FF);
    FillChar(Temp^,BS,$FF);
  end;
  inherited Burn;
end;

procedure TDCP_blockcipher.SetIV(const Value);
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  Move(Value,IV^,BS);
  Reset;
end;

procedure TDCP_blockcipher.GetIV(var Value);
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  Move(Chain^,Value,BS);
end;

procedure TDCP_blockcipher.Encrypt(const Indata; var Outdata; Size: longint);
begin
  case fCipherMode of
    cmCBC: EncryptCBC(Indata,Outdata,Size);
    cmCFB8bit: EncryptCFB8bit(Indata,Outdata,Size);
    cmCFBblock: EncryptCFBblock(Indata,Outdata,Size);
    cmOFB: EncryptOFB(Indata,Outdata,Size);
  end;
end;

function TDCP_blockcipher.EncryptString(const Str: string): string;
begin
  SetLength(Result,Length(Str));
  EncryptCFB8bit(Str[1],Result[1],Length(Str));
  Result:= Base64EncodeStr(Result);
end;

function TDCP_blockcipher.DecryptString(const Str: string): string;
begin
  Result:= Base64DecodeStr(Str);
  DecryptCFB8bit(Result[1],Result[1],Length(Result));
end;

procedure TDCP_blockcipher.Decrypt(const Indata; var Outdata; Size: longint);
begin
  case fCipherMode of
    cmCBC: DecryptCBC(Indata,Outdata,Size);
    cmCFB8bit: DecryptCFB8bit(Indata,Outdata,Size);
    cmCFBblock: DecryptCFBblock(Indata,Outdata,Size);
    cmOFB: DecryptOFB(Indata,Outdata,Size);
  end;
end;

procedure TDCP_blockcipher.EncryptCBC(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: pointer;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    EncryptECB(p2^,p2^);
    Move(p2^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.DecryptCBC(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: pointer;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    Move(p1^,p2^,BS);
    Move(p1^,Temp^,BS);
    DecryptECB(p2^,p2^);
    XorBlock(p2^,Chain^,BS);
    Move(Temp^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.EncryptCFB8bit(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: Pbyte;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to Size do
  begin
    EncryptECB(Chain^,Temp^);
    p2^:= p1^ xor Pbyte(Temp)^;
    Move(pointer(longint(Chain)+1)^,Chain^,BS-1);
    Pbyte(longint(Chain)+BS-1)^:= p2^;
    Inc(p1);
    Inc(p2);
  end;
end;

procedure TDCP_blockcipher.DecryptCFB8bit(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: Pbyte;
  TempByte: byte;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to Size do
  begin
    TempByte:= p1^;
    EncryptECB(Chain^,Temp^);
    p2^:= p1^ xor Pbyte(Temp)^;
    Move(pointer(longint(Chain)+1)^,Chain^,BS-1);
    Pbyte(longint(Chain)+BS-1)^:= TempByte;
    Inc(p1);
    Inc(p2);
  end;
end;

procedure TDCP_blockcipher.EncryptCFBblock(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: Pbyte;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    Move(p2^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.DecryptCFBblock(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: Pbyte;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    Move(p1^,Temp^,BS);
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    Move(Temp^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.EncryptOFB(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: pointer;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.DecryptOFB(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: pointer;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

constructor TDCP_blockcipher.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BS:= GetBlockSize shr 3;
  IV:= nil; Chain:= nil; Temp:= nil;
  try
    GetMem(IV,BS);
    GetMem(Chain,BS);
    GetMem(Temp,BS);
  except
    FreeMem(IV,BS);
    FreeMem(Chain,BS);
    raise EDCP_blockcipher.Create('Insufficient memory');
  end;
  fCipherMode:= cmCBC;
end;

destructor TDCP_blockcipher.Destroy;
begin
  FreeMem(IV);
  FreeMem(Chain);
  FreeMem(Temp);
  IV:= nil;      { Make sure that burn doesn't try to fillchar freed memory }
  inherited Destroy;
end;



{** TDCP_hash *****************************************************************}

procedure TDCP_hash.DeadInt(Value: longint);
begin
end;

procedure TDCP_hash.DeadStr(Value: string);
begin
end;

procedure TDCP_hash.UpdateStream(Stream: TStream; Size: longint);
var
  Buffer: array[0..8191] of byte;
  i, read: integer;
begin
  for i:= 1 to (Size div Sizeof(Buffer)) do
  begin
    read:= Stream.Read(Buffer,Sizeof(Buffer));
    Update(Buffer,read);
  end;
  if (Size mod Sizeof(Buffer))<> 0 then
  begin
    read:= Stream.Read(Buffer,Size mod Sizeof(Buffer));
    Update(Buffer,read);
  end;
end;

procedure TDCP_hash.UpdateStr(const Str: string);
begin
  Update(Str[1],Length(Str));
end;

destructor TDCP_hash.Destroy;
begin
  if fInitialized then
    Burn;
  inherited Destroy;
end;



{** Helper functions **********************************************************}


function DCPcipherfromname(const Value: string; AOwner: TComponent): TDCP_cipher;
var
  Next: PDCP_cipherinfo;
  CName: string;
begin
  Next:= DCPcipherlist;
  CName:= LowerCase(Value);
  while (Next<> nil) and (Next^.Name<> CName) do
    Next:= Next^.Next;
  if Next<> nil then
    if Next^.Block then  // not sure if this is needed but ....
      Result:= TDCP_cipher(TDCP_blockcipherclass(Next^.Cipher).Create(AOwner))
    else
      Result:= Next^.Cipher.Create(AOwner)
  else
    Result:= nil;
end;

function DCPcipherfromid(Value: longint; AOwner: TComponent): TDCP_cipher;
var
  Next: PDCP_cipherinfo;
begin
  Next:= DCPcipherlist;
  while (Next<> nil) and (Next^.Id<> Value) do
    Next:= Next^.Next;
  if Next<> nil then
    if Next^.Block then  // not sure if this is needed but ....
      Result:= TDCP_cipher(TDCP_blockcipherclass(Next^.Cipher).Create(AOwner))
    else
      Result:= Next^.Cipher.Create(AOwner)
  else
    Result:= nil;
end;

function DCPhashfromname(const Value: string; AOwner: TComponent): TDCP_hash;
var
  Next: PDCP_hashinfo;
  HName: string;
begin
  Next:= DCPhashlist;
  HName:= LowerCase(Value);
  while (Next<> nil) and (Next^.Name<> HName) do
    Next:= Next^.Next;
  if Next<> nil then
    Result:= Next^.Hash.Create(AOwner)
  else
    Result:= nil;
end;

function DCPhashfromid(Value: longint; AOwner: TComponent): TDCP_hash;
var
  Next: PDCP_hashinfo;
begin
  Next:= DCPhashlist;
  while (Next<> nil) and (Next^.Id<> Value) do
    Next:= Next^.Next;
  if Next<> nil then
    Result:= Next^.Hash.Create(AOwner)
  else
    Result:= nil;
end;

procedure DCPregcipher(Cipher: TDCP_cipherclass; Block: boolean);
var
  NewCipher: PDCP_cipherinfo;
begin
  New(NewCipher);
  NewCipher^.Cipher:= Cipher;
  NewCipher^.Name:= LowerCase(Cipher.GetAlgorithm);
  NewCipher^.Id:= Cipher.GetId;
  NewCipher^.Next:= DCPcipherlist;
  NewCipher^.Block:= Block;
  DCPcipherlist:= NewCipher;
end;

procedure DCPreghash(Hash: TDCP_hashclass);
var
  NewHash: PDCP_hashinfo;
begin
  New(NewHash);
  NewHash^.Hash:= Hash;
  NewHash^.Name:= LowerCase(Hash.GetAlgorithm);
  NewHash^.Id:= Hash.GetId;
  NewHash^.Next:= DCPhashlist;
  DCPhashlist:= NewHash;
end;

procedure DCPregfree;
var
  NextCipher: PDCP_cipherinfo;
  NextHash: PDCP_hashinfo;
begin
  while (DCPcipherlist<> nil) do
  begin
    NextCipher:= DCPcipherlist^.Next;
    Dispose(DCPcipherlist);
    DCPcipherlist:= NextCipher;
  end;
  while (DCPhashlist<> nil) do
  begin
    NextHash:= DCPhashlist^.Next;
    Dispose(DCPhashlist);
    DCPhashlist:= NextHash;
  end;
end;


procedure XorBlock(var InData1, InData2; Size: longint);
var
  i: integer;
begin
  for i:= 1 to Size do
    Pbyte(longint(@InData1)+i-1)^:= Pbyte(longint(@InData1)+i-1)^ xor Pbyte(longint(@InData2)+i-1)^;
end;

function CompareMemory(X1, X2: PByteArray; Size: longint): boolean;
var
  i: longint;
begin
  Result:= true;
  for i:= 1 to Size do
    if X1^[i-1]<> X2^[i-1] then
      Result:= false;
end;

function LRot16(X: Word; c: longint): Word;
begin
  LRot16:= (X shl c) or (X shr (16 - c));
end;

function RRot16(X: Word; c: longint): Word;
begin
  RRot16:= (X shr c) or (X shl (16 - c));
end;

function LRot32(X: DWord; c: longint): DWord;
begin
  Result := (X shl c) or (X shr (32 - c));
end;

function RRot32(X: DWord; c: longint): DWord;
begin
  Result := (X shr c) or (X shl (32 - c));
end;

function SwapDWord(X: DWord): DWord;
begin
  Result:= (X shr 24) or ((X shr 8) and $FF00) or ((X shl 8) and $FF0000) or (X shl 24);
end;

procedure TDCP_sha1.Compress;
var
  A, B, C, D, E: DWord;
  W: array[0..79] of DWord;
  i: longint;
begin
  Index:= 0;
  Move(HashBuffer,W,Sizeof(HashBuffer));
  for i:= 0 to 15 do
    W[i]:= SwapDWord(W[i]);
  for i:= 16 to 79 do
    W[i]:= ((W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]) shl 1) or ((W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]) shr 31);
  A:= CurrentHash[0]; B:= CurrentHash[1]; C:= CurrentHash[2]; D:= CurrentHash[3]; E:= CurrentHash[4];

  Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[ 0]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[ 1]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[ 2]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[ 3]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[ 4]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[ 5]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[ 6]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[ 7]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[ 8]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[ 9]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[10]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[11]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[12]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[13]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[14]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[15]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[16]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[17]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[18]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[19]); C:= (C shl 30) or (C shr 2);

  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[20]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $6ED9EBA1 + W[21]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $6ED9EBA1 + W[22]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $6ED9EBA1 + W[23]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[24]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[25]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $6ED9EBA1 + W[26]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $6ED9EBA1 + W[27]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $6ED9EBA1 + W[28]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[29]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[30]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $6ED9EBA1 + W[31]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $6ED9EBA1 + W[32]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $6ED9EBA1 + W[33]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[34]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[35]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $6ED9EBA1 + W[36]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $6ED9EBA1 + W[37]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $6ED9EBA1 + W[38]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[39]); C:= (C shl 30) or (C shr 2);

  Inc(E,((A shl 5) or (A shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[40]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + ((A and B) or (C and (A or B))) + $8F1BBCDC + W[41]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + ((E and A) or (B and (E or A))) + $8F1BBCDC + W[42]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + ((D and E) or (A and (D or E))) + $8F1BBCDC + W[43]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[44]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[45]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + ((A and B) or (C and (A or B))) + $8F1BBCDC + W[46]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + ((E and A) or (B and (E or A))) + $8F1BBCDC + W[47]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + ((D and E) or (A and (D or E))) + $8F1BBCDC + W[48]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[49]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[50]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + ((A and B) or (C and (A or B))) + $8F1BBCDC + W[51]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + ((E and A) or (B and (E or A))) + $8F1BBCDC + W[52]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + ((D and E) or (A and (D or E))) + $8F1BBCDC + W[53]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[54]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[55]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + ((A and B) or (C and (A or B))) + $8F1BBCDC + W[56]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + ((E and A) or (B and (E or A))) + $8F1BBCDC + W[57]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + ((D and E) or (A and (D or E))) + $8F1BBCDC + W[58]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[59]); C:= (C shl 30) or (C shr 2);

  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[60]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[61]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[62]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[63]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[64]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[65]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[66]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[67]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[68]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[69]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[70]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[71]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[72]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[73]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[74]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[75]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[76]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[77]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[78]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[79]); C:= (C shl 30) or (C shr 2);

  CurrentHash[0]:= CurrentHash[0] + A;
  CurrentHash[1]:= CurrentHash[1] + B;
  CurrentHash[2]:= CurrentHash[2] + C;
  CurrentHash[3]:= CurrentHash[3] + D;
  CurrentHash[4]:= CurrentHash[4] + E;
  FillChar(W,Sizeof(W),0);
  FillChar(HashBuffer,Sizeof(HashBuffer),0);
end;

class function TDCP_sha1.GetAlgorithm: string;
begin
  Result:= 'SHA1';
end;

class function TDCP_sha1.GetId: longint;
begin
  Result:= DCP_sha1;
end;

class function TDCP_sha1.GetHashSize: longint;
begin
  Result:= 160;
end;

class function TDCP_sha1.SelfTest: boolean;
const
  Test1Out: array[0..19] of byte=
    ($A9,$99,$3E,$36,$47,$06,$81,$6A,$BA,$3E,$25,$71,$78,$50,$C2,$6C,$9C,$D0,$D8,$9D);
  Test2Out: array[0..19] of byte=
    ($84,$98,$3E,$44,$1C,$3B,$D2,$6E,$BA,$AE,$4A,$A1,$F9,$51,$29,$E5,$E5,$46,$70,$F1);
var
  TestHash: TDCP_sha1;
  TestOut: array[0..19] of byte;
begin
  TestHash:= TDCP_sha1.Create(nil);
  TestHash.Init;
  TestHash.UpdateStr('abc');
  TestHash.Final(TestOut);
  Result:= boolean(CompareMemory(@TestOut,@Test1Out,Sizeof(Test1Out)));
  TestHash.Init;
  TestHash.UpdateStr('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq');
  TestHash.Final(TestOut);
  Result:= boolean(CompareMemory(@TestOut,@Test2Out,Sizeof(Test2Out))) and Result;
  TestHash.Free;
end;

procedure TDCP_sha1.Init;
begin
  Burn;
  CurrentHash[0]:= $67452301;
  CurrentHash[1]:= $EFCDAB89;
  CurrentHash[2]:= $98BADCFE;
  CurrentHash[3]:= $10325476;
  CurrentHash[4]:= $C3D2E1F0;
  fInitialized:= true;
end;

procedure TDCP_sha1.Burn;
begin
  LenHi:= 0; LenLo1:= 0; LenLo2:= 0;
  Index:= 0;
  FillChar(HashBuffer,Sizeof(HashBuffer),0);
  FillChar(CurrentHash,Sizeof(CurrentHash),0);
  fInitialized:= false;
end;

procedure TDCP_sha1.Update(const Buffer; Size: longint);
var
  PBuf: ^byte;
begin
  if not fInitialized then
    raise EDCP_hash.Create('Hash not initialized');

  { I wish Borland had included an unsigned 32bit from the start }
  Inc(LenLo1,(Size shl 3) and $FFFF);
  if LenLo1< ((Size shl 3) and $FFFF) then
  begin
    Inc(LenLo2);
    if LenLo2= 0 then
      Inc(LenHi);
  end;
  Inc(LenLo2,Size shr 13);
  if LenLo2< ((Size shr 13) and $FFFF) then
    Inc(LenHi);
  Inc(LenHi,Size shr 29);

  PBuf:= @Buffer;
  while Size> 0 do
  begin
    if (Sizeof(HashBuffer)-Index)<= DWord(Size) then
    begin
      Move(PBuf^,HashBuffer[Index],Sizeof(HashBuffer)-Index);
      Dec(Size,Sizeof(HashBuffer)-Index);
      Inc(PBuf,Sizeof(HashBuffer)-Index);
      Compress;
    end
    else
    begin
      Move(PBuf^,HashBuffer[Index],Size);
      Inc(Index,Size);
      Size:= 0;
    end;
  end;
end;

procedure TDCP_sha1.Final(var Digest);
begin
  if not fInitialized then
    raise EDCP_hash.Create('Hash not initialized');
  HashBuffer[Index]:= $80;
  if Index>= 56 then
    Compress;
  PDWord(@HashBuffer[56])^:= SwapDWord(LenHi);
  PDWord(@HashBuffer[60])^:= SwapDWord(LenLo1 or (longint(LenLo2) shl 16));
  Compress;
  CurrentHash[0]:= SwapDWord(CurrentHash[0]);
  CurrentHash[1]:= SwapDWord(CurrentHash[1]);
  CurrentHash[2]:= SwapDWord(CurrentHash[2]);
  CurrentHash[3]:= SwapDWord(CurrentHash[3]);
  CurrentHash[4]:= SwapDWord(CurrentHash[4]);
  Move(CurrentHash,Digest,Sizeof(CurrentHash));
  Burn;
end;

end.
